      ! XX   
      ! LEE SERGEY
      ! 2103/1 (gruppa)
      ! 25.09.12     
 	  
      Program F2012_3                               
      Implicit NONE

        INTEGER P,M,I,J,L,O,C,D,DET
	  DOUBLE PRECISION X(4)
	  DOUBLE PRECISION V(5,5),N(5,5),B(5),H(5),W,T
	  COMMON W,T

        PRINT *, 'XX'                
        PRINT *, 'LEE SERGEY'        
        PRINT *, '2103/1'                            
        PRINT *, '25.09.12'        
        PRINT *        
  
        C=17
        P=4
	  M=P
	  O=P
     
	  D=DET(M,C)
	  IF(D==0)THEN
	    M=0
	    N=0
		O=0
	    PRINT*,'DETERMINANT IS ZERO'
        END IF      
	 
	  DO I=1,M
	    V(I,I)=C-(M-I)*2
	  END DO
	  DO I=2,M
	    DO J=1,I-1
	      V(J,I)=1
	      V(I,J)=1
          END DO
	  END DO
        DO I=1,M
          B(I)=C-(M-I-1)*2
        END DO
	  
	  DO I=1,M
	    DO J=1,M
	      N(I,J)=1
	    END DO
          H(I)=1
        END DO

        DO L=1,O-1
	    DO I=L+1,P                                   
	      V(I,L)=V(I,L)*N(L,L)  
		  N(I,L)=N(I,L)*V(L,L)
	      W=V(I,L)
	      T=N(I,L)
		  CALL OUT_Arr(W,T)
            V(I,L)=W
	      N(I,L)=T		                   
          END DO

	    B(L)=B(L)*N(L,L)
	    H(L)=H(L)*V(L,L)
	    W=B(L)
	    T=H(L)
	    CALL OUT_Arr(W,T)
	    B(L)=W
	    H(L)=T
			
	    DO I=L+1,P                                                       
	      DO J=L+1,M                                                 
	        V(J,I)=V(J,I)*N(L,I)*N(J,L)-V(L,I)*V(J,L)*N(J,I)
			N(J,I)=N(J,I)*N(L,I)*N(J,L)
			W=V(J,I)
	        T=N(J,I)
		    CALL OUT_Arr(W,T)
              V(J,I)=W
	        N(J,I)=T	              
	      END DO  
		                                                       
	      B(I)=B(I)*H(L)*N(L,I)-B(L)*V(L,I)*H(I)
	      H(I)=H(I)*H(L)*N(L,I)
	      W=B(I)
	      T=H(I)
	      CALL OUT_Arr(W,T)
	      B(I)=W
	      H(I)=T
            V(L,I)=0
		  N(L,I)=1                                                  
	    END DO                                                      
	    V(L,L)=1
		N(L,L)=1                                                   
	  END DO

	  X(P)=B(P)*N(P,P)/H(P)/V(P,P)

	  DO I=P-1,1,-1
	    L=M                                  
	    O=I
	    DO WHILE((P-O)>0)
	      B(I)=B(I)*N(L,I)-V(L,I)*H(I)*X(L)
	      H(I)=H(I)*N(L,I)	      
	      X(I)=B(I)/H(I)
	      L=L-1
		  O=O+1	
           END DO
     	  END DO
	  
	  DO I=1,M	    
	    WRITE (6,*) 'X',I,'=',X(I)
	  END DO
	  X(1)=X(1)+X(2)+X(3)+X(4)*17  
        PRINT*, X(1)
        END                                            

******************************
	SUBROUTINE  Out_Arr(W,T)         
      IMPLICIT NONE  
	  
	  DOUBLE PRECISION R,P,W,T
	  INTEGER*8 I
	
        IF(W>T)THEN
	    P=T
	    R=W
	  ELSE                      
	    P=W
	    R=T
	  END IF

        DO WHILE((MOD(P,2.0).EQ.0).AND.(MOD(R,2.0).EQ.0))
	    P=P/2
	    R=R/2	    
	  END DO
        DO WHILE((MOD(P,3.0).EQ.0).AND.(MOD(R,3.0).EQ.0))
	    P=P/3
	    R=R/3
	  END DO
	  DO WHILE((MOD(P,5.0).EQ.0).AND.(MOD(R,5.0).EQ.0))
	    P=P/5
	    R=R/5
	  END DO
	  DO WHILE((MOD(P,7.0).EQ.0).AND.(MOD(R,7.0).EQ.0))
	    P=P/7.0
	    R=R/7.0
	  END DO

	  IF(P==R)THEN
	    P=1
	  	R=1
	  ELSE
	    DO I=11,300000,2
	      IF(MOD(R,DBLE(I)).EQ.0)THEN
	        IF(MOD(P,DBLE(I)).EQ.0)THEN
	          DO WHILE((MOD(P,DBLE(I)).EQ.0).AND.(MOD(R,DBLE(I)).EQ.0))
	            R=R/DBLE(I)
			    P=P/DBLE(I)
			  END DO
		    END IF
		  END IF		
	  	END DO   
        END IF
	  
	  IF(W>T)THEN
	    W=R
	    T=P
	  ELSE                      
	    W=P
	    T=R
	  END IF

      RETURN                  
      END 


	RECURSIVE FUNCTION DET (N,C) RESULT(D)
      INTEGER M,D,N,I,B,Q,E,A,V(40,2),L,C
	INTEGER F(5,5)
      COMMON B,M,E,Q,V,L
       
	  IF(L==0)THEN
	    M=N
	    L=L+1
	  END IF
 	
	  D=0
	
        DO I=1,M
	    F(I,I)=C-(M-I)*2
	  END DO
	  DO I=2,M
	    DO J=1,I-1
	      F(J,I)=1
	      F(I,J)=1
          END DO
	  END DO

	  DO A=1,M-3
          E=V(A,1)
	    Q=V(A,2)
	    DO I=E,1,-1
	      DO J=Q,M
	        F(I+Q-1,J)=F(I+Q-2,J)
	      END DO
	    END DO
        END DO
 	  
	  IF(N>2)THEN
   	    DO I=M-N+1,M
	      B=I
            IF(N>3)THEN
	        V(M-N+1,1)=I-M+N-1
	        V(M-N+1,2)=M-N+2
            END IF 
		  D=D+DET(N-1,C)*F(I,M-N+1)*(-1)**(M-N+1+I)
          END DO
   	  ELSE
    	    IF(B==M-2)THEN
	      D=F(M-1,M-1)*F(M,M)-F(M,M-1)*F(M-1,M)
          END IF
	    IF(B==M-1)THEN
	      D=F(M-2,M-1)*F(M,M)-F(M,M-1)*F(M-2,M)
          END IF
	    IF(B==M)THEN
	      D=F(M-2,M-1)*F(M-1,M)-F(M-1,M-1)*F(M-2,M)
          END IF
   	  END IF

      END
       
       
	

